home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / examples / helpsigs / Parsspec.sml < prev    next >
Encoding:
Text File  |  1997-08-18  |  3.5 KB  |  102 lines  |  [TEXT/R*ch]
  1. (* Parsspec -- parse Moscow ML signature files.
  2.  
  3. *)
  4.  
  5. open BasicIO List
  6.  
  7. (* Lexer of stream *)
  8.  
  9. fun createLexerStream (is : instream) =
  10.   Lexing.createLexer (fn buff => fn n => Nonstdio.buff_input is buff 0 n)
  11. ;
  12.  
  13. fun parsePhraseAndClear parsingFun lexingFun lexbuf =
  14.   let val phr =
  15.     parsingFun lexingFun lexbuf
  16.     handle x => (Parsing.clearParser(); raise x)
  17.   in
  18.     Parsing.clearParser();
  19.     phr
  20.   end;
  21.  
  22. val parseSpec =
  23.   parsePhraseAndClear Parser.SigFile Lexer.Token;
  24.  
  25. fun processSpec is str ((Location.Loc(pos1, pos2), spec), res) =
  26.     let fun getline line pos =
  27.         if pos < pos1 then 
  28.         case Nonstdio.input_char is of
  29.             #"\^Z" => raise Fail "Parsspec.processSpec: internal error"
  30.           | #"\n"  => getline (line+1) (pos+1)
  31.           | _      => getline line (pos+1)
  32.         else line
  33.     val lineno = (Nonstdio.seek_in is 0; getline 0 0)
  34.     open Asynt Database
  35.     fun getId ({qualid = {id, ...}, ...} : IdInfo) = id
  36.     fun valdesc ((idInfo, ty), res) = 
  37.         {comp = Val (getId idInfo), str = str, line = lineno} :: res
  38.     fun pvaldesc ((idInfo, ty, arity, cfun), res) = 
  39.         {comp = Val (getId idInfo), str = str, line = lineno} :: res
  40.     fun typdesc ((tyvars, idInfo), res) = 
  41.         {comp = Typ (getId idInfo), str = str, line = lineno} :: res
  42.     fun typbind ((tyvars, idInfo, ty), res) = 
  43.         {comp = Typ (getId idInfo), str = str, line = lineno} :: res
  44.     fun conbind ((ConBind(idInfo, tyOpt)), res) = 
  45.         {comp = Con (getId idInfo), str = str, line = lineno} :: res
  46.     fun datbind ((tyvars, idInfo, cbs), res) =
  47.         {comp = Typ (getId idInfo), str = str, line = lineno} 
  48.         :: foldl conbind res cbs
  49.     fun exdesc ((idInfo, tyOpt), res) = 
  50.         {comp = Exc (getId idInfo), str = str, line = lineno} :: res
  51.     in
  52.     case spec of
  53.         VALspec vs                  => foldl valdesc res vs
  54.       | PRIM_VALspec pvs            => foldl pvaldesc res pvs
  55.       | TYPEDESCspec (tnEqu, tyds)  => foldl typdesc res tyds
  56.       | TYPEspec tybs               => foldl typbind res tybs
  57.       | DATATYPEspec (dbs, tybsOpt) => 
  58.         foldl datbind (foldl typbind res (getOpt(tybsOpt, []))) dbs
  59.       | EXCEPTIONspec eds           => foldl exdesc res eds
  60.       | LOCALspec (spec1, spec2)    => processSpec is str (spec2, res)
  61.       | OPENspec strs               => res
  62.       | EMPTYspec                   => res
  63.       | SEQspec (spec1, spec2)      => 
  64.         processSpec is str (spec2, processSpec is str (spec1, res))
  65.     end
  66.  
  67. fun parseAndProcess dir str res =
  68.     let val filename = Path.joinDirFile
  69.         {dir=dir, file = Path.joinBaseExt{base = str, ext = SOME "sig"}}
  70.     val _ = print("Parsing " ^ filename ^ " ... "); 
  71.     val resLength = length res
  72.     val is           = open_in filename
  73.     val lexbuf       = createLexerStream is
  74.     val specs        = case parseSpec lexbuf of
  75.                             Asynt.NamedSig {specs, ...} => specs
  76.                   | Asynt.AnonSig specs         => specs;
  77.     val initialbase = {comp = Database.Str, str = str, line = 0} :: res
  78.     val res = foldl (processSpec is str) initialbase specs
  79.     val _ = print ("processed " ^ Int.toString (length res - resLength)
  80.                ^ " entries.\n")
  81.     in
  82.     close_in is; res
  83.     end
  84.     handle exn as Parsing.ParseError _ => 
  85.     (print ("Parseerror in signature " ^ str ^ ".\n"); raise exn)
  86.  
  87. (* To parse the signature of unit `filename' and prepend the 
  88.  * entries to the list res:
  89.  *)
  90.  
  91. fun processfile stoplist dir (filename, res) =
  92.     let val {base, ext} = Path.splitBaseExt filename
  93.     in 
  94.     case ext of
  95.         SOME "sig" => 
  96.         if List.exists (fn name => base = name) stoplist then 
  97.             res
  98.         else 
  99.             parseAndProcess dir base res
  100.       | _          => res
  101.     end
  102.